home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap04 / howto04 / delphi10 / ccprnmgr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-26  |  11.7 KB  |  333 lines
  1. unit Ccprnmgr;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, Printers, DRWSUtl1;
  8.  
  9. type
  10.   TCCPrintForm = class(TForm)
  11.     ComboBox1: TComboBox;
  12.     Label1: TLabel;
  13.     BitBtn1: TBitBtn;
  14.     BitBtn3: TBitBtn;
  15.     BitBtn4: TBitBtn;
  16.     Bevel1: TBevel;
  17.     Label2: TLabel;
  18.     Label3: TLabel;
  19.     Label4: TLabel;
  20.     Bevel2: TBevel;
  21.     Label5: TLabel;
  22.     Label6: TLabel;
  23.     Bevel3: TBevel;
  24.     ListBox1: TListBox;
  25.     Label7: TLabel;
  26.     BitBtn6: TBitBtn;
  27.     BitBtn7: TBitBtn;
  28.     BitBtn8: TBitBtn;
  29.     Label8: TLabel;
  30.     Label9: TLabel;
  31.     Label10: TLabel;
  32.     Label11: TLabel;
  33.     RadioGroup1: TRadioGroup;
  34.     BitBtn9: TBitBtn;
  35.     FontDialog1: TFontDialog;
  36.     BitBtn10: TBitBtn;
  37.     BitBtn11: TBitBtn;
  38.     BitBtn12: TBitBtn;
  39.     PrintDialog1: TPrintDialog;
  40.     PrinterSetupDialog1: TPrinterSetupDialog;
  41.     procedure FormCreate(Sender: TObject);
  42.     procedure BitBtn1Click(Sender: TObject);
  43.     procedure BitBtn7Click(Sender: TObject);
  44.     procedure BitBtn9Click(Sender: TObject);
  45.     procedure RadioGroup1Click(Sender: TObject);
  46.     procedure BitBtn6Click(Sender: TObject);
  47.     procedure BitBtn4Click(Sender: TObject);
  48.   private
  49.     { Private declarations }
  50.   public
  51.     { Public declarations }
  52.     procedure HandlePrinting;
  53.   end;
  54.  
  55. var
  56.   CCPrintForm: TCCPrintForm;
  57.  
  58. implementation
  59.  
  60. {$R *.DFM}
  61.  
  62. procedure TCCPrintForm.HandlePrinting;
  63. var TheFile      : TextFile;    { Used to open text files     }
  64.     TheBitmap    : TBitmap;     { Used to open bitmap files   }
  65.     Counter_1 ,                 { Loop Counter for Selections }
  66.     Counter_2    : Integer;     { Loop Counter for lines      }
  67.     TheString    : String;      { Text file IO handler        }
  68.     TestString   : String;      { Used to check file extension}
  69.     Info         : PBitmapInfo; { Used to print bitmap        }
  70.     InfoSize     : Integer;     { Used to print bitmap        }
  71.     Image        : Pointer;     { Used to print bitmap        }
  72.     ImageSize    : Longint;     { Used to print bitmap        }
  73.     Bits         : HBITMAP;     { Used to print bitmap        }
  74.     DIBWidth ,                  { Used to print bitmap        }
  75.     DIBHeight    : Longint;     { Used to print bitmap        }
  76.     PrintWidth ,                { Used to print bitmap        }
  77.     PrintHeight  : Longint;     { Used to print bitmap        }
  78. begin
  79.   { Print text and bitmap files directly and shell all }
  80.   { other files out to windows to print, if possible.  }
  81.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  82.   begin
  83.     { Allow checks for hitting abort button }
  84.     Application.ProcessMessages;
  85.     if Printer.Aborted then exit;
  86.     { Check for selected file in the listbox to do a print }
  87.     if ListBox1.Selected[ Counter_1 ] then
  88.     begin
  89.       { Check against extension of file selected }
  90.       TestString := Uppercase( ExtractFileExt( ListBox1.Items[ Counter_1 ] ));
  91.       if TestString = '.TXT' then
  92.       begin { Print out text files directly to demo method }
  93.         { Call begindoc method }
  94.         Printer.BeginDoc;
  95.         try
  96.           { Try to assign and open the file, barf if can't }
  97.           AssignFile( TheFile , ListBox1.Items[ Counter_1 ] );
  98.           Reset( TheFile );
  99.           { Set the lines printed counter }
  100.           Counter_2 := 1;
  101.           { Run to the end of the file }
  102.           while not EOF( TheFile ) do
  103.           begin
  104.             { Allow the user to abort }
  105.             Application.ProcessMessages;
  106.             if Printer.Aborted then
  107.             begin
  108.               { Display brief abort message }
  109.               Label6.Font.Color := clRed;
  110.               Label6.Caption := 'Aborting...';
  111.               Label6.Show;
  112.               { Go bye bye }
  113.               exit;
  114.             end;
  115.             { Do the actual printing with textout }
  116.             { Read the next line in               }
  117.             Readln( TheFile , TheString );
  118.             { Put it out down the page per line }
  119.             Printer.Canvas.TextOut( 10 , 20 +
  120.              ( Counter_2  * ( Printer.Canvas.TextHeight( 'W' ) + 5 )) ,
  121.               TheString );
  122.             { Increment the line counter and test for end of page }
  123.             Counter_2 := Counter_2 + 1;
  124.             if (( Counter_2 * ( Printer.Canvas.TextHeight( 'W' ) +
  125.              5 )) + 20 ) > ( Printer.PageHeight - 20 ) then
  126.             begin
  127.               { Send a form feed to printer and reset line counter }
  128.               Printer.NewPage;
  129.               Counter_2 := 1;
  130.             end;
  131.           end;
  132.           { Close the file being printed }
  133.           CloseFile( TheFile );
  134.         except
  135.           { Assume HandlePrint reraises exception }
  136.           On E:EPrinter do
  137.           begin
  138.             { Beep on error }
  139.             MessageBeep( MB_ICONEXCLAMATION );
  140.             { Set status label color to red }
  141.             Label6.Font.Color := clRed;
  142.             { Set the caption to the error message }
  143.             Label6.Caption := E.Message;
  144.             { If any exceptions occur chicken out and dump }
  145.             Printer.Abort;
  146.             exit;
  147.           end;
  148.         end;
  149.         { Call Enddoc method }
  150.         Printer.EndDoc;
  151.       end
  152.       else
  153.       begin
  154.         if TestString = '.BMP' then
  155.         begin { Print out bitmap files directly to demo method }
  156.           { If not graphics capabile signal error }
  157.           if Label9.Caption = 'Graphics Capable'
  158.           then
  159.           begin
  160.             { Otherwise create the bitmap and load the file }
  161.             TheBitmap := TBitmap.Create;
  162.             try
  163.               TheBitmap.LoadFromFile( ListBox1.Items[ Counter_1 ] );
  164.             except
  165.               { Abort on error }
  166.               raise;
  167.               exit;
  168.             end;
  169.             try
  170.               { Start the printing }
  171.               {Printer.BeginDoc;}
  172.               { Perform magic since normal canvas stuff won't work! }
  173.               with Printer, Canvas do
  174.               begin
  175.                 { Get a handle to the bitmap's data }
  176.                 Bits := TheBitmap.Handle;
  177.                 { Find out memory requirements }
  178.                 GetDIBSizes(Bits, InfoSize, ImageSize);
  179.                 { Get a pointer to enough memory for structure }
  180.                 Info := MemAlloc(InfoSize);
  181.                 try
  182.                   { Now try to hold the bits }
  183.                   Image := MemAlloc(ImageSize);
  184.                   try
  185.                     { And conver them to Device Independent }
  186.                     GetDIB(Bits, 0, Info^, Image^);
  187.                     with Info^.bmiHeader do
  188.                     begin
  189.                       { Get width and height when done }
  190.                       DIBWidth := biWidth;
  191.                       DIBHeight := biHeight;
  192.                     end;
  193.                     { Set these to enlarge but could scale }
  194.                     PrintWidth := DIBWidth * 3;
  195.                     PrintHeight := DIBHeight * 3;
  196.                     { Do actual print via StretchDIBits API call }
  197.                     StretchDIBits(Canvas.Handle, 20 , 20 , PrintWidth,
  198.                      PrintHeight, 0, 0, DIBWidth, DIBHeight, Image,
  199.                       Info^, DIB_RGB_COLORS, SRCCOPY);
  200.                   finally
  201.                     { Release memory regardless }
  202.                     FreeMem(Image, ImageSize);
  203.                   end;
  204.                 finally
  205.                   { Release more memory regardless }
  206.                   FreeMem(Info, InfoSize);
  207.                   { Free the bitmap }
  208.                   TheBitmap.Free;
  209.                 end;
  210.               end;
  211.               { End the printing }
  212.               Printer.EndDoc;
  213.             except
  214.               { Assume HandlePrint reraises exception }
  215.               On E:EPrinter do
  216.               begin
  217.                 { Beep on error }
  218.                 MessageBeep( MB_ICONEXCLAMATION );
  219.                 { Set status label color to red }
  220.                 Label6.Font.Color := clRed;
  221.                 { Set the caption to the error message }
  222.                 Label6.Caption := E.Message;
  223.                 { If any exceptions occur chicken out and dump }
  224.                 Printer.Abort;
  225.                 exit;
  226.               end;
  227.             end;
  228.           end
  229.           { Complain about printing to nonraster device! }
  230.           else MessageDlg( 'Cannot Print A Bitmap On Non-Graphics Printer!',
  231.            mtError, [mbOK],0 );
  232.         end
  233.         else
  234.         begin
  235.           { Otherwise try to shell out to windows to print complex file }
  236.           if not ShellExec( ExpandFileName( ListBox1.Items[ Counter_1 ] )
  237.             , '' , '', true , SW_SHOWMINIMIZED , true ) then
  238.             MessageDlg('Could not Print ' + ListBox1.Items[ Counter_1 ] ,
  239.              mtError, [mbOK], 0);
  240.         end;
  241.       end;
  242.     end;
  243.   end;
  244. end;
  245.  
  246. procedure TCCPrintForm.FormCreate(Sender: TObject);
  247. begin
  248.   { Clear the combobox and assign the available printers }
  249.   Combobox1.Clear;
  250.   Combobox1.Items.Assign( Printer.Printers );
  251.   Combobox1.Itemindex := Printer.PrinterIndex;
  252.   { Display currently active printer }
  253.   Label4.Caption := Printer.Printers[ Printer.PrinterIndex ];
  254.   { Display resolution of currently active printer }
  255.   Label11.Caption := 'Width: ' + InttoStr( Printer.PageWidth ) +
  256.    ' Height: ' + IntToStr( Printer.PageHeight );
  257.   { Display orientation of currently active printer }
  258.   case Printer.Orientation of
  259.     poPortrait  : RadioGroup1.ItemIndex := 0;
  260.     poLandscape : RadioGroup1.ItemIndex := 1;
  261.   end;
  262.   { Set label for status }
  263.   Label6.Font.Color := clBlack;
  264.   Label6.Caption := 'Idle';
  265.   { Determine basic device capabilities of the selected printer }
  266.   if GetDeviceCaps( Printer.Handle , TECHNOLOGY ) = DT_RASPRINTER then
  267.    Label9.Caption := 'Graphics Capable' else Label9.Caption := 'Character Device';
  268.   if GetDeviceCaps( Printer.Handle , BITSPIXEL ) > 1 then
  269.    Label8.Caption := 'Color Capable' else Label8.Caption := 'Monochrome';
  270.   Label10.Caption := 'Resolution: ' +
  271.    IntToStr( GetDeviceCaps( Printer.Handle , LOGPIXELSX )) + ' dpi';
  272. end;
  273.  
  274. procedure TCCPrintForm.BitBtn1Click(Sender: TObject);
  275. begin
  276.   { Set the Default printer to be the selection of the combobox }
  277.   Printer.PrinterIndex := ComboBox1.ItemIndex;
  278.   { And cleverly reset the display! }
  279.   FormCreate( Self );
  280. end;
  281.  
  282. procedure TCCPrintForm.BitBtn7Click(Sender: TObject);
  283. begin
  284.   { This just runs the printer setup dialog }
  285.   PrinterSetupDialog1.Execute;
  286. end;
  287.  
  288. procedure TCCPrintForm.BitBtn9Click(Sender: TObject);
  289. begin
  290.   { This just displays available fonts for the printer }
  291.   if FontDialog1.Execute then Printer.Canvas.Font := FontDialog1.Font;
  292. end;
  293.  
  294. procedure TCCPrintForm.RadioGroup1Click(Sender: TObject);
  295. begin
  296.   { Set the printer orientation based on the radiogroup itemindex }
  297.   case RadioGroup1.ItemIndex of
  298.     0 : Printer.Orientation := poPortrait;
  299.     1 : Printer.Orientation := poLandscape;
  300.   end;
  301. end;
  302.  
  303. procedure TCCPrintForm.BitBtn6Click(Sender: TObject);
  304. begin
  305.   { If execute print dialog then call HandlePrint method and deal with exceptions }
  306.   if PrintDialog1.Execute then
  307.   begin
  308.     { Reset Label font color }
  309.     Label6.Font.Color := clBlack;
  310.     { Change status label to printing }
  311.     Label6.Caption := 'Printing...';
  312.     { Call HandlePrinting Method }
  313.     HandlePrinting;
  314.     { Reset the display to indicate printing not in progress }
  315.     if Label6.Caption = 'Printing...' then Label6.Caption := 'Idle';
  316.   end;
  317. end;
  318.  
  319. procedure TCCPrintForm.BitBtn4Click(Sender: TObject);
  320. begin
  321.   { If already printing do abort }
  322.   if Printer.Printing then
  323.   begin
  324.     { call abort method }
  325.     Printer.Abort;
  326.     { Reset status label }
  327.     Label6.Font.Color := clBlack;
  328.     Label6.Caption := 'Aborted...';
  329.   end;
  330. end;
  331.  
  332. end.
  333.